{
Traviesadora beta 0.2.0.13.33 (30.11.2008)
LastMod: 02.12.2008 by Prof1983

Copyright 2008, travieorama@googlemail.com

This file is part of the taviesadora project

taviesadora is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

taviesadora is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
}
unit MovieLibrary;

interface

uses
  Classes, SysUtils, Dialogs, {DCPmd4,} ComCtrls, Forms, Service;

const
  schlssel = 20;
  sep = '~|';
type
  TSearchFor = (sfMovieName,sfPlayListName,sfID,sfHashMovieName);
  TPlayListItem = record
    PlayListName: string;
    PlaceOnPlaylist: Integer;
    PlayedLastTime: Boolean;
  end;
  TMovieRecord = record
    open: Boolean;
    ID: Integer;
    filename: string;
    Ext: string;
    hash: string;
    size: Cardinal;
    PLItem: TPlayListItem;
    EncryptFileName: string;
  end;
  PMovieRecord = ^TMovieRecord;



  TMovieLib = class
  published
    constructor create(LibFileName:string;Tree:TTreeview);
    destructor destroy;    override;
    function PlayMovieByName(Name:string):string;
    function PlaySelMovie:string;
    function GetMovieFileName(ID:integer):string;
    procedure CloseMovie;
    procedure SetLibFileName(LibFileName:string);
    function GetPlayingID:integer;
    procedure AddMovie(FileName:string);
    procedure DeleteMovie(ID:integer);
    procedure DeleteSelectedMovie;
    procedure Save;
    function GetAskString:string;
    function OpenMovieByAskString(AskString:string;Owner:TComponent):string;
  private
    Lib:TTreeNodes;  //We want aswell Playlists so a tree is a better choise
    TreeView:TTreeView;
    AutoValueForID:integer;
    LibFileName:string;
    OpenMovieID:integer;
    function SearchInNode(searchstr1,searchstr2:string;searchType:TSearchFor;SearchChildren:boolean):TTreeNode;
    function SearchPlaylistEntryNode(PlayListName:string):TTreeNode;
    function SearchID(ID:integer):TTreeNode;
    function SearchHashAndMovie(hash,MovieName:string):TTreeNode;
    function SearchMovieName(MovieName:string):TTreeNode;
    function PlayMovieByNode(Node:TTreeNode):string;
    procedure DeleteByNode(Node:TTreeNode);
    procedure ParseLib;
    procedure SaveLib;
    function IsEncrypted(MRec:TMovieRecord):boolean;
    function GetNewID:integer;
  end;

implementation

uses
  LinkToed2kwin, HashProgressWin;

Function GetEd2kHash(FN: string): string;
//http://www.amule.org/wiki/index.php/Ed2k_link-de
{
  const
    chunks=9728000;
  var
    Hash: TDCP_md4;
    Digest: array[0..15] of byte;  //16 bajtni hash

    Source: TFileStream;
    ed2k:TMemoryStream;
    sizedc,i,k: integer;
    s: string;
}

begin
  {
  frmHashProgress := TfrmHashProgress.create(FN,nil);
  try
    Result:='';
    Source:= nil;
    if not FileExists(Fn) then exit;
    try
      Source:= TFileStream.Create(FN,fmOpenRead);
    except
      MessageDlg('Unable to open file',mtError,[mbOK],0);
    end;
    if Source <> nil then begin
      Hash:= TDCP_md4.Create(NIL);   // create the hash


      ed2k :=TMemoryStream.Create;

      sizedc:=(Source.Size div chunks)+1;
      if Source.Size mod chunks =0 then dec(sizedc);

      for i:=1 to sizedc do begin
        Hash.Init; // initialize it

        if i=sizedc then
         Hash.UpdateStream(Source,(Source.Size mod chunks))
        else
         Hash.UpdateStream(Source,chunks);       // hash the stream contents

        Hash.Final(Digest);

        for k:=0 to 15 do begin
          ed2k.WriteBuffer(Digest[k],1);
        end;
        frmHashProgress.SetProgress(i,sizedc);
         //possible usage ProgressBar1.Position:=100*i div sizedc;

      end;

      ed2k.Seek(0,soFromBeginning);
      Hash.Init;
      Hash.UpdateStream(ed2k, ed2k.Size); // hash the stream contents

      Hash.Final(Digest);
      ed2k.Free;
      Hash.Free;

      s:= '';
      for i:= 0 to 15 do
       s:= s +IntToHex(Digest[i],2);
      Result:=s;
    end;
    Source.Free;
  finally
    frmHashProgress.Close;
  end;
  }
end;

function GetFileSize(FileName:string):Cardinal;
var
  FStream: TFileStream;
begin
  if FileExists(FileName) then
  begin
    FStream := TFileStream.Create(FileName,fmShareDenyNone+fmOpenRead);
    try
      result := FStream.Size;
    finally
      FStream.Free;
    end;
  end;
end;

procedure DecryptFile(a: string);
var
  v: file of Byte;
  f: Integer;
  C: Byte;
begin
  if lowercase(ExtractFileExt(a))<> '.cmg' then
    c := 0;
  AssignFile(v,a);
  Reset(v);
  for f := 0 to 1024 do
  begin
    if eof(v) then
      break;
    read(v,c);
    Seek(V,f);
    c := c xor schlssel;
    write(v,c);
  end;
  closefile(v);
end;

procedure Verschluesseldatei(a:string);
var
 v: file of Byte;
 f:integer;
 C:Byte;
begin
 if lowercase(ExtractFileExt(a)) <> '.cmg' then
   c := 0;
 AssignFile(v,a);
 Reset(v);
 for f := 0 to 1024 do begin
  if eof(v) then
   break;
  read(v,c);
  Seek(V,f);
  c := c xor schlssel;
  write(v,c);
  if filepos(v) > filesize(v) then
   break;
 end;
 closefile(v);
end;

procedure CloseMedia(filename, cryptedname: string);
begin
 RenameFile(filename,cryptedname);
 Verschluesseldatei(cryptedname);
end;

procedure OpenMedia(cryptedname, filename: string);
begin
  if FileExists(cryptedname) then begin
   RenameFile(cryptedname,filename);
   DecryptFile(filename);
  end else begin
   MessageDlg('Die Datei '+cryptedname+' konnte nicht gefunden werden!',mtError,[mbOK],0);
  end;
end;

function ExtractFileNameWoExt(FileName:string):string;
var
  i:integer;
begin
  FileName := ExtractFileName(FileName);
  i := length(FileName);
  while i > 0 do begin
    if FileName[i] = '.' then break;
    dec(i);
  end;
  delete(FileName,i,length(FileName));
  result := FileName;
end;

function TrimToPlayListName(FileName:string):string;
var
  i:integer;
begin
  FileName := ExtractFileNameWoExt(FileName);
  i :=  pos('CD',FileName);
  if i = 1 then begin
    for i := 1 to length(FileName) do begin
      if (FileName[i]= ' ')or (FileName[i]= '-')or (FileName[i]= '_')or(FileName[i]= '.') then
       break;
    end;
    delete(FileName,1,i);
  end else if i > 1 then begin
    delete(FileName,i,length(FileName));
  end;
  result := trim(FileName);
end;


{ TMovieLib }

function TMovieLib.IsEncrypted(MRec:TMovieRecord):boolean;
var
  s:string;
begin
  s := Lowercase(ExtractFileExt(MRec.filename));
  result := s='.cmg';
end;

procedure TMovieLib.SetLibFileName(LibFileName: string);
begin
  self.LibFileName := LibFileName;
end;

constructor TMovieLib.Create(LibFileName: string; Tree: TTreeview);
begin
  inherited Create;
  Lib := Tree.items;
  TreeView := Tree;
  AutoValueForID := 0;
  OpenMovieID := -1;
  SetLibFileName(LibFileName);
  ParseLib;
end;

destructor TMovieLib.destroy;
var
  MRec:PMovieRecord;
  Node:TTreeNode;
  ChildNode:TTreeNode;
begin
  save;
  Node := Lib.GetFirstNode;
  while Node <> nil do begin
    MRec := Node.Data;
    if MRec <> nil then begin
      if MRec.ID = OpenMovieID then begin
        CloseMovie;
      end else if MRec.open then begin
        if IsEncrypted(Mrec^) then
          CloseMedia(Mrec.filename,mrec.EncryptFileName);
        MRec.open := false;
      end;
      dispose(MRec);
    end;
    ChildNode := Node.getFirstChild;
    while ChildNode <> nil do begin
      MRec := ChildNode.Data;
      if MRec <> nil then begin
        if MRec.ID = OpenMovieID then begin
          CloseMovie;
        end else if MRec.open then begin
          if IsEncrypted(Mrec^) then
            CloseMedia(Mrec.filename,mrec.EncryptFileName);
          MRec.open := false;
        end;
        dispose(MRec);
      end;
      ChildNode := ChildNode.getNextSibling;
    end;
    Node := Node.getNextSibling;
  end;
  lib.Clear;
  inherited destroy;
end;



function TMovieLib.SearchInNode(searchstr1,searchstr2: string; searchType: TSearchFor;SearchChildren:boolean): TTreeNode;

  function test(MRec:PMovieRecord;searchstr1,searchstr2: string; searchType: TSearchFor):boolean;
  begin
    case searchType of
      sfMovieName:      result := lowercase(ExtractFileNameWoExt(MRec.PLItem.PlayListName)) = searchstr1;
      sfPlayListName:   result := lowercase(MRec.PLItem.PlayListName) = searchstr1;
      sfID:             result := inttostr(Mrec.ID) = searchstr1;
      sfHashMovieName:  result := (lowercase(MRec.hash) = searchstr1) or (lowercase(ExtractFileName(MRec.FileName)) = searchstr2)
    end;
  end;

var
 MRec:PMovieRecord;
 NodeChild:TTreeNode;
 Node:TTreeNode;
 found:boolean;
begin
  found := false;
  result := nil;
  searchstr1 := LowerCase(searchstr1);
  searchstr2 := LowerCase(searchstr2);
  if searchType = sfMovieName then
    searchstr1 := ExtractFileNameWoExt(searchstr1);
  Node := Lib.GetFirstNode;
  while Node <> nil do begin
    MRec := Node.Data;
    if MRec <> nil then begin
      found := test(MRec,searchstr1,searchstr2,searchType);
      if found then begin
        result := Node;
        break;
      end;
    end;
    if SearchChildren then begin
      NodeChild := Node.getFirstChild;
      while NodeChild <> nil do begin
        MRec := NodeChild.Data;
        if MRec <> nil then begin
          found := test(MRec,searchstr1,searchstr2,searchType);
          if found then begin
            result := NodeChild;
            break;
          end;
        end;
        NodeChild := NodeChild.getNextSibling;
      end;
    end;
    if found then break;
    Node := Node.GetNextSibling;
  end;
end;

function TMovieLib.SearchHashAndMovie(hash,MovieName:string): TTreeNode;

begin
  result := SearchInNode(hash,MovieName,sfHashMovieName,true);
end;

function TMovieLib.SearchID(ID: integer): TTreeNode;
begin
  result := SearchInNode(inttostr(ID),'',sfID,true);
end;

function TMovieLib.SearchPlaylistEntryNode( PlayListName: string): TTreeNode;
var
  Node:TTreeNode;
  MRec1,MRec2:PMovieRecord;
begin
  result := SearchInNode(PlayListName,'',sfPlayListName,false);
  if result <> nil then
    if not result.HasChildren then begin
      MRec2 := result.Data;
      Node := Lib.AddChild(result,ExtractFileNameWoExt(Mrec2.filename));
      new(Mrec1);
      Node.Data := MRec1;
      MRec1^ := MRec2^;
      MRec1.ID := GetNewID;
      MRec2.PLItem.PlaceOnPlaylist := -1;
      MRec2.ID := -1;
    end;
end;


function TMovieLib.SearchMovieName(MovieName: string): TTreeNode;
begin
  result := SearchInNode(MovieName,'',sfMovieName,true);
end;

procedure TMovieLib.ParseLib;
  function GetFieldValue(name,str:string):string;
  begin
    Delete(str,1,length(name)+1);
    result := trim(str);
  end;
var
  i: Integer;
  MRec: PMovieRecord;
  SList: TStringList;
  STokenizer: TStringTokenizer;
  Node: TTreeNode;
  s: string;
  F: file;
begin
  if not(FileExists(LibFileName)) then
  begin
    AssignFile(F, LibFileName);
    Rewrite(F);
    CloseFile(F);
  end;

  STokenizer := TStringTokenizer.Create('');
  SList := TStringList.Create;
  try
    STokenizer.SetTrenner(sep); //~|
    SList.LoadFromFile(LibFileName);
    SList.Insert(0, 'dshow://');
    for i := 0 to SList.Count-1 do
    begin
      STokenizer.SetText(SList[i]);
      s := STokenizer.NextToken;
      if s = '' then continue;
      new(MRec);
      MRec.ID := GetNewID;
      MRec.filename := s;
      MRec.EncryptFileName := STokenizer.NextToken;
      if not FileExists(MRec.EncryptFileName) then
        if FileExists(MRec.filename) then
          MRec.EncryptFileName := MRec.filename;
      MRec.size := StrToIntDef(STokenizer.NextToken,0);
      if MRec.size = 0 then
        MRec.size := GetFileSize(MRec.EncryptFileName);
      MRec.Ext := STokenizer.NextToken;
      MRec.hash := '';
      MRec.open := false;
      MRec.PLItem.PlayListName := TrimToPlayListName(Mrec.filename);
      MRec.PLItem.PlaceOnPlaylist := 0;
      MRec.PLItem.PlayedLastTime := false;
      while STokenizer.StillAToken do begin
        s := STokenizer.NextToken;
        if pos('hash',s) > 0 then begin
          MRec.hash := GetFieldValue('hash',s);
        end else if pos('plname',s) > 0 then begin
          MRec.PLItem.PlayListName := GetFieldValue('plname',s);
        end else if pos('placeonpl',s) > 0 then begin
          MRec.PLItem.PlaceOnPlaylist := StrToIntDef(GetFieldValue('placeonpl',s),0);
        end else if pos('lastplayed',s) > 0 then begin
          MRec.PLItem.PlayedLastTime := true;
        end ;
      end;
      if MRec.hash = '' then begin
        if IsEncrypted(MRec^) then
          OpenMedia(MRec.EncryptFileName,MRec.filename);
        MRec.hash := GetEd2kHash(MRec.filename);
        if IsEncrypted(MRec^) then
          CloseMedia(Mrec.filename,mrec.EncryptFileName);
      end;
      Node := SearchPlaylistEntryNode(MRec.PLItem.PlayListName);
      if Node = nil then begin
        Node := Lib.Add(nil,'');
        Node.Text := MRec.PLItem.PlayListName;
      end else begin
        Node := lib.AddChild(NOde,'');
        Node.text := ExtractFileNameWoExt(Mrec.filename);
      end;
      Node.Data := MRec;
    end;
  finally
    STokenizer.Free;
    SList.Free;
  end;
end;

procedure TMovieLib.Save;
  function RecToStr(MRec:TMovieRecord):string;
  begin
    result :=  MRec.filename+sep+
               MRec.EncryptFileName+sep+
               Inttostr(Mrec.size)+sep+
               MRec.Ext+sep+
               'hash='+MRec.hash;
    if MRec.PLItem.PlayListName <> '' then begin
      result:=result+sep+'plname='+Mrec.PLItem.PlayListName+sep+'placeonpl='+IntToStr(MRec.PLItem.PlaceOnPlaylist);
      if MRec.PLItem.PlayedLastTime then
          result:= result+sep+'LastPlayed';
    end;
  end;
var
  i:integer;
  MRec:PMovieRecord;
  SList:TStringList;
  PlayListName:string;
  Node:TTreeNode;
  NodeChild:TTreeNode;
begin
  SList := TStringList.Create;
  try
    Node := Lib.GetFirstNode;
    while Node <> nil do begin
      MRec := Node.Data;
      PlayListName := MRec.PLItem.PlayListName;
      if PlayListName = '' then
        PlayListName := TrimToPlayListName(MRec.filename);
      if Node.HasChildren then begin
        NodeChild := Node.getFirstChild;
        while NodeChild <> nil do begin
          MRec := NodeChild.Data;
          MRec.PLItem.PlayListName := PlayListName;
          SList.Add(RecToStr(MRec^));
          NodeChild := NodeChild.getNextSibling;
        end;
      end else
       SList.Add(RecToStr(MRec^));
      Node := Node.getNextSibling;
    end;
    SList.SaveToFile(LibFileName);
  finally
    SList.Free;
  end;
end;

procedure TMovieLib.SaveLib;
begin
  Save;
end;

function TMovieLib.GetMovieFileName(ID: integer): string;
var
  MRec:PMovieRecord;
  Node:TTreeNode;
begin
  result := '';
  MRec := nil;
  Node := SearchID(ID);
  if Node <> nil then
    MRec := Node.data;
  if MRec <> nil then
    result := MRec.filename;
end;


function TMovieLib.PlayMovieByNode(Node: TTreeNode): string;
var
  MRec:PMovieRecord;
  //Node:TTreeNode;
begin
  result := '';
  if Node <> nil then begin
    MRec := Node.Data;
    if MRec <> nil then begin
      if OpenMovieID = -1 then begin
        if IsEncrypted(MRec^) then begin
          OpenMedia(MRec.EncryptFileName,Mrec.filename);
        end;
        OpenMovieID := MRec.ID;
        MRec.open := true;
        result := MRec.filename;
      end;
    end;
  end;
end;




function TMovieLib.PlayMovieByName(Name: string): string;
var
  Node:TTreeNode;
begin
  Node := SearchMovieName(Name);
  result := PlayMovieByNode(Node);
end;


function TMovieLib.PlaySelMovie: string;
var
  MRec:PMovieRecord;
  Node:TTreeNode;
begin
  result := PlayMovieByNode(TreeView.Selected);
end;


procedure TMovieLib.CloseMovie;
var
  MRec:PMovieRecord;
  NOde:TTreeNode;
begin
  MRec := nil;
  if OpenMovieID =-1 then exit;
  NOde := SearchID(OpenMovieID);
  if Node <> nil then
    MRec := Node.Data;
  if MRec <> nil then begin
    if IsEncrypted(Mrec^) then
     CloseMedia(Mrec.filename,mrec.EncryptFileName);
    MRec.open := false;
    OpenMovieID := -1;
  end;
end;

procedure TMovieLib.DeleteByNode(Node:TTreeNode);
var
  MRec:PMovieRecord;
begin
  if Node <> nil then begin
    MRec := Node.Data;
    if MRec <> nil then begin
      if MRec.ID = OpenMovieID then
        CloseMovie;
      Dispose(MRec);
    end;
    lib.Delete(node);
  end;
end;

procedure TMovieLib.DeleteMovie(ID: integer);
begin
  DeleteByNode(SearchID(ID));
end;

procedure TMovieLib.DeleteSelectedMovie;
begin
  DeleteByNode(TreeView.Selected);
end;

procedure TMovieLib.AddMovie(FileName: string);
var
  MRec:PMovieRecord;
  Node:TTreeNode;
begin
  new(Mrec);
  MRec.filename := FileName;
  Mrec.EncryptFileName := FileName;
  MRec.Ext := ExtractFileExt(FileName);
  MRec.size := GetFileSize(FileName);
  MRec.hash := GetEd2kHash(FileName);
  MRec.open := false;
  MRec.PLItem.PlayListName := TrimToPlayListName(FileName);
  MRec.PLItem.PlaceOnPlaylist := 0;
  MRec.PLItem.PlayedLastTime := false;
  MRec.ID := GetNewID;
  Node := Lib.Add(nil,MRec.PLItem.PlayListName);
  Node.Data := MRec;
end;

function TMovieLib.GetAskString: string;
var
  MRec:PMovieRecord;
  Node:TTreeNode;
begin
  result := '';
  if OpenMovieID = -1 then exit;
  Node := SearchID(OpenMovieID);
  if Node <> nil then
    MRec := Node.data;
  if MRec <> nil then begin
    result := 'file'+sep+ExtractFileName(MRec.filename)+sep+inttostr(MRec.size)+sep+Mrec.hash;
  end;
end;

function TMovieLib.OpenMovieByAskString(AskString:string;Owner:TComponent): string;
var
  MRec:PMovieRecord;
  Node:TTreeNode;
  name:string;
  hash:string;
  STokenizer:TStringTokenizer;
  i:integer;
  s:string;
begin
  result := '';
  STokenizer := TStringTokenizer.Create(AskString);
  try
    STokenizer.SetTrenner(sep);
    STokenizer.NextToken;
    Name := STokenizer.NextToken;
    STokenizer.NextToken;
    hash := STokenizer.NextToken;
    Node := SearchHashAndMovie(hash,Name);
    if Node <> nil then begin
      result := PlayMovieByNode(Node);
    end else begin
      s := AskString;
      FrmLinkToEd2k := TFrmLinkToEd2k.create(Owner,Name,s,self);
    end;
  finally
    STokenizer.free;
  end;
end;




function TMovieLib.GetNewID: integer;
begin
  inc(AutoValueForID);
  result := AutoValueForID;
end;


function TMovieLib.GetPlayingID: integer;
begin
  result := OpenMovieID;
end;

end.
